home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / dscal.f < prev    next >
Text File  |  1989-08-17  |  3KB  |  77 lines

  1. c   imsl routine name   - vbla=dscal                                    vbdj0010
  2. c
  3. c-----------------------------------------------------------------------
  4. c
  5. c   computer            - vax/double
  6. c
  7. c   latest revision     - january 1, 1978
  8. c
  9. c   purpose             - compute a double precision constant
  10. c                           times a double precision vector
  11. c
  12. c   usage               - call dscal (n,da,dx,incx)
  13. c
  14. c   arguments    n      - length of vector x. (input)
  15. c                da     - double precision scalar. (input)
  16. c                dx     - double precision vector of length n*incx.
  17. c                           (input/output)
  18. c                           dscal replaces x(i) with da*x(i) for
  19. c                           i=1,...,n.
  20. c                           x(i) refers to a specific element of dx.
  21. c                           see incx argument description.
  22. c                incx   - displacement between elements of dx. (input)
  23. c                           x(i) is defined to be dx(1+(i-1)*incx).
  24. c                           incx must be greater than zero.
  25. c
  26. c   precision/hardware  - double/all
  27. c
  28. c   reqd. imsl routines - none required
  29. c
  30. c   notation            - information on special notation and
  31. c                           conventions is available in the manual
  32. c                           introduction or through imsl routine uhelp
  33. c
  34. c   copyright           - 1978 by imsl, inc. all rights reserved.
  35. c
  36. c   warranty            - imsl warrants only that imsl testing has been
  37. c                           applied to this code. no other warranty,
  38. c                           expressed or implied, is applicable.
  39. c
  40. c-----------------------------------------------------------------------
  41. c
  42.       subroutine dscal  (n,da,dx,incx)
  43. c
  44. c                                  specifications for arguments
  45.       double precision   da,dx(1)
  46.       integer            n,incx
  47. c                                  specifications for local variables
  48.       integer            i,m,mp1,ns
  49. c                                  first executable statement
  50.       if (n.le.0) return
  51.       if (incx.eq.1) go to 10
  52. c                                  code for increments not equal to 1.
  53.       ns = n*incx
  54.       do 5 i=1,ns,incx
  55.          dx(i) = da*dx(i)
  56.     5 continue
  57.       return
  58. c                                  code for increments equal to 1.
  59. c                                    clean-up loop so remaining vector
  60. c                                    length is a multiple of 5.
  61.    10 m = n-(n/5)*5
  62.       if (m.eq.0) go to 20
  63.       do 15 i=1,m
  64.          dx(i) = da*dx(i)
  65.    15 continue
  66.       if (n.lt.5) return
  67.    20 mp1 = m+1
  68.       do 25 i=mp1,n,5
  69.          dx(i) = da*dx(i)
  70.          dx(i+1) = da*dx(i+1)
  71.          dx(i+2) = da*dx(i+2)
  72.          dx(i+3) = da*dx(i+3)
  73.          dx(i+4) = da*dx(i+4)
  74.    25 continue
  75.       return
  76.       end
  77.